Best of Shareware/Best of PC Windows Shareware 1.0 - Wayzata Technology (7111) (1993).iso/mac/DOS/CAD_CAM/WCEDT202/WC.LSP

Lisp/Scheme | 1992-08-29 | 30KB | 903 lines

;;;**************************************************************************
;;;   WC.LSP
;;;   (C) 1992 by ELSA America, Inc.
;;;
;;;   A part of the
;;;           WCEDIT  -- ADS Programable text editor.
;;;
;;;   Conceived and implemented by:
;;;           Walt Craig
;;;           Oct 1991
;;;
;;;**************************************************************************
;;;
;;;   WALT CRAIG PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. WALT CRAIG
;;;   SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY OR
;;;   FITNESS FOR A PARTICULAR USE.  WALT CRAIG DOES NOT WARRANT THAT
;;;   THE OPERATION OF THE PROGRAM WILL BE UNNINTERRUPTED OR ERROR FREE.
;;;
;;;**************************************************************************
;;;
;;; DESCRIPTION
;;;
;;;   WC.LSP is the loader for WCEDIT. Upon loading, a configuration
;;;   file is loaded. The function (WCconfig ) defineds
;;;   the keys and (wc_setvar) sets various variables.
;;;
;;;   System control is shared and passed between C:WC and WCEdit
;;;   to provide a method in which to 'drive' WCEdit within AutoCAD.
;;;
;;;   Note:
;;;      Altering the functions C:WC, PROCESS or WCERR is not recommended.
;;;
;;;**************************************************************************
(if(not WCedit)                     ;If it's not already defined
   (progn                           ;
      (xload "WCedit")              ;Then xload it in
   )
)
;------------------ Main calling function -----------------------------------
(defun c:WC( / __lst__ __nme__)
   (setq __nme__ (list 0 ""))     ;Force to the loop to enter
   (setq __olderr__ *error* *error* WCerr);Set the error to return to the editor
   (while(and(listp __nme__)__nme__)   ;While nme is a list with a value
      (setq *error* WCerr)             ;Set the error to return to the editor
      (setq __nme__(WCedit))           ;Call the editor with no parameters
      (if (and (listp __nme__) __nme__);If the exit code is a list with a value
         (process __nme__)     ;Then call the lisp routine 'process' sending the
      )                        ;list of (scancode "lisp function name")
   )
   (setq *error* __olderr__)   ;Kill errors from returning to the editor
;  (graphscr)                  ;Remout this line if ya want.
   (if (= (type __nme__) 'STR) ;If nme is a string then We'll run it!
      (progn
         (eval(list(read __nme__))) ;Run the routine
         (command "script" "wcrld");If No errors , then we'll return
      )
   )
   (prin1)
);End of WC program
;-------------------- Process function evaluator ----------------------------

;-------------------- __mykey__ is a global ---------------------------------
(defun process(__stuff__  / __name__)      ;Figure out what to do
   (setq __mykey__(car __stuff__))    ;This is scancode for the key you hit
   (setq __name__(cadr __stuff__))    ;This is the name of the lisp func as a string
   (if (not (listp (read __name__)))
      (progn
         (if (not(eval(read __name__))) ;Test to see if it is defined before evaluating
            (WC_message (strcat "Function: " __name__ " is not defined!")0)
            (eval(list(read __name__))) ;Run the routine
         )
      )
      (progn
         (eval(read __name__)) ;Run the routine
      )
   )
   (prin1)
);End of the process routine
;---------------------- Wc error routine ------
(defun WCerr(msg)          ;This is the error routine
   (setq globalerr msg        ;Save a copy of error to refer back to
      *error* __olderr__
   )
   (if wcedit
      (progn
         (setvar "CMDECHO" 0)
         (command "script" "wcrld")
         (wc_message (strcat "AutoLISP *error*: " (strcase msg nil)) 0)
      )
   )
   (prin1)
);End of the WCerr routine

;*********************** ALL Functions listed below may be modified ********
;******************* to suit your needs ************************************
(wcconfig "(wc_toggle \"TOCASE\")" 1.0 "Toggle case sensitivity")

;;;Deletes a window by a double key stroke action where the
;;;arrow key must coincide with the edge of a window to be
;;;deleted. This is used explicitly for the Brief configuration.
(defun delwin()
   (setq way(nth 14 (wc_statistics)))
   (if(/= way 0)
      (progn
         (wc_print "Select window edge to delete (use cursor).")
         (setq a(wc_message "" 0))
      )
   )
   (cond
      ((or (= way 1)(= way 2))
         (if(or(= (wc_gname a) "Right")(= (wc_gname a) "Left"))
            (wc_trigger "MAKE_ONE")
            (wc_print "Edge does not have a window")
         )
      )
      ((or (= way 3)(= way 4))
         (if(or(= (wc_gname a) "Up")(= (wc_gname a) "Down"))
            (wc_trigger "MAKE_ONE")
            (wc_print "Edge does not have a window")
         )
      )
      (t
         (wc_print "Edge does not have a window")
      )
   )
)
(wcconfig "delwin" 1.0 "Delete window edge")

;;;Opens  a window by a double key stroke action where the
;;;arrow key determines the direction by which to open the
;;;window. Used explicitly by Brief.lsp.
(defun splitc()
   (wc_print "Select side for new window (use cursor).")
   (setq a(wc_message "" 0))
   (cond
      ((or (= (wc_gname a) "Right")(= (wc_gname a) "Left"))
         (wc_trigger "SPLIT_CENTER_U")
         (wc_refresh 1)
      )
      ((or (= (wc_gname a) "Up")(= (wc_gname a) "Down"))
         (wc_trigger "SPLIT_CENTER_R")
         (wc_refresh 1)
      )
      (t
         (wc_print " ")
      )
   )
)
(wcconfig "splitc" 1.0 "Open window")

;;;This sets up the book markers for use with gbmark and sabmark.
(defun sbmark()
   (setq __bmark(list
         '(1 (nil nil))
         '(2 (nil nil))
         '(3 (nil nil))
         '(4 (nil nil))
         '(5 (nil nil))
      )
   )
)

;;;Jump to previously saved book mark <position in file>
(defun gbmark()
   (if(not __Bmark)
      (sbmark)
   )
   (setq j(wc_fetch_int "Go to Bookmark [1-5]: " 1 1))
   (setq old (cadr(assoc j __bmark)))
   (if (or (not( nth 0 old)) (not (nth 1 old)))
      (progn
         (wc_beep 5000.0 9000.0)
         (wc_print "That Bookmark doesn't exist.")
      )
      (progn
         (wc_row (nth 0 old))
         (wc_col (nth 1 old))
         (wc_refresh 1)
         (wc_print (strcat "Bookmark "(itoa j)" restored."))
      )
   )
)

;;;Save bookmark <position in file>
(defun sabmark(/ old new)
   (if(not __Bmark)
      (sbmark)
   )
   (setq ky __mykey__)
   (cond
      ((= __mykey__  (wc_gkey "Alt 1"))
         (setq k 1)
      )
      ((= __mykey__  (wc_gkey "Alt 2"))
         (setq k 2)
      )
      ((= __mykey__  (wc_gkey "Alt 3"))
         (setq k 3)
      )
      ((= __mykey__  (wc_gkey "Alt 4"))
         (setq k 4)
      )
      ((= __mykey__  (wc_gkey "Alt 5"))
         (setq k 5)
      )
      (t (setq k nil))
   )
   (if k
      (progn
         (setq old (assoc k __bmark))
         (setq new (list k (list (wc_row -1)(wc_col -1))))
         (setq __bmark(subst new old __bmark))
         (wc_print (strcat "Bookmark "(itoa k)" saved."))
      )
   )
)

(defun rem_spaces(str / i ch outstr)
   (wc_trimends str)
)

;;;This is used to toggle the insert mode on/off
(defun togins()
   (wc_toggle "INSERT_MODE")
)

;;;This simply returns the current/active file name.
(defun gcname()
   (setq lst(wc_statistics)one(nth 0 lst)two (nth 1 lst)side(nth 14 lst))
   (cond
      ((or (= side 0)(= side 2)(= side 4))
         one
      )
      (t two)
   )
)

;;;This function simply displays the current filename as a print.
(defun disp_fname()
   (wc_print gcname)
   (prin1)
)

;;;This will either bring up the file passed as the current file and
;;;return 't or nil if the file is not loaded into WCEdit.
(defun tog_to_name(name / i nbuffs)
   (setq nbuffs(nth 13 (wc_statistics))i 0)
   (setq name (strcase name nil));Make the case upper.
   (setq name (rem_spaces name));REmove any trailing spaces
   (while (and (< i nbuffs)(/= name (gcname)))
      (wc_trigger "TOGGLE_FILE")
      (setq i (+ 1 i))
   )
   (if( = name (gcname))
      't
      nil
   )
)

;;;This will 'zap' the file called by name from WCEdit. WARNING! Use
;;;this function with care since it does not check for file upsets.
(defun zap_name(name)
   (if(tog_to_name name)
      (progn
         (setq i(nth 18 (wc_statistics)))
         (wc_trigger "TOGGLE_FILE")
         (if(= i (nth 18 (wc_statistics)))
            (progn
               (wc_silent 0)
               (wc_message "Attempted to delete last buffer!" 0)
               (quit)
            )
            (wc_remove_buffer i)
         )
      )
      (progn
         (wc_silent 0)
         (wc_message "Name does not exist!" 0)
         (quit)
      )
   )
)


;;;This is just a little fun I've thrown in.
(defun shave()
   (WC_message "Shave and a hair cut .... " 1)
   (WC_shave)
   (WC_refresh 1)
)
(wcconfig "shave" 1.0 "Shave and a Hair cut")

;;;Use this routine for file checking if needed. The routine
;;;will look to see if the file 'name' exists. If it does
;;;exist, then a message appears asking the user if he/she
;;;wants to overwrite. The function returns 't if ok to
;;;overwrite or nil for not ok.
(defun check_file(name)
   (setq answer 't)
   (if name
      (progn
         (if(findfile name)
            (progn
               (setq answer(WC_message "File exists! Overwrite? N" 0))
               (if answer
                  (progn
                     (setq answer(WC_castchar answer))
                     (if(or(= answer "Y")(= answer "y"))
                        (setq answer 't)
                        (setq answer nil)
                     )
                  )
               )
            )
         )
      )
      (setq answer nil)
   )
   answer
)

;;;Register the function 'CHECKOUT' to a key...this thing is the neatest
;;;little thing I've come with in a long time! Should sell it!
;;;After you've registered it to a key move the cursor to anything your
;;;curious about, <a variable, list, whatever>. Then hit the key you've
;;;registered it to and the message window will pull up with a little
;;;info about that thing...you'll love it!
(defun symstr(sym / fp a)
   (princ sym(setq fp(open "$$TRASH.$@1" "w")))
   (close fp)
   (setq a(read-line(setq fp(open "$$TRASH.$@1" "r"))))
   (close fp)
   (eval a)
)

(defun checkout(/ value first thing pt)
   ;(setq pt(wc_prev_word))
   (setq pt(wc_next_word))
   (setq value(eval(read pt)) first(strcat "[" pt "]: "))
   (cond
      ((= (type value) 'sym)
         (setq thing (strcat first "SYM  = "(symstr value)))
      )
      ((= (type value) 'list)
         (if pprint
            (setq thing (pprint value nil) thing nil)
            (setq thing (strcat  first "LIST  = "(symstr value)))
         )
      )
      ((= (type value) 'file)
         (setq thing (strcat  first "FILE  = "(symstr value)))
      )
      ((= (type value) 'subr)
         (setq thing (strcat  first "SUBR  = "(symstr value)))
      )
      ((= (type value) 'exsubr)
         (setq thing (strcat  first "EXSUBR  = "(symstr value)))
      )
      ((= (type value) 'PICKSET)
         (setq thing (strcat  first "PICKSET  = "(symstr value)))
      )
      ((= (type value) 'ENAME)
         (setq thing (strcat  first "ENAME  = "(symstr value)))
      )
      ((= (type value) 'PAGETB)
         (setq thing (strcat  first "PAGETB = "(symstr value)))
      )
      ((= (type value) 'REAL)
         (setq thing (strcat  first "REAL = "(rtos value 2 2)))
      )
      ((= (type value) 'INT)
         (setq thing (strcat  first "INT = "(itoa value)))
      )
      ((= (type value) 'STR)
         (setq thing (strcat  first "STR = " "\"" value "\""))
      )
      ((= (type value) nil)
         (setq thing (strcat  first "Is nil" ))
      )
   )
   (if thing
      (progn
      (wc_stuffkey (wc_gkey "Home"))
      (wc_fetch_string (strcat thing
         "")
         " Evaluates to: "
      " Escape Exits ")
      )
   )
)
(wcconfig "checkout" 1.0 "Evaluate the next AutoLISP expression")

;;;ETOS function from Inside Autolisp
(defun etos (arg / file)
   (if (= 'STR (type arg))
      (setq arg (strcat "\"" arg "\""))
   )
   (setq file (open "$" "w"))
   (princ arg file)
   (close file)
   (setq file (open "$" "r"))
   (setq arg (read-line file))
   (close file)
   (close (open "$" "w"))
   arg
);defun

;This function is for direct access to AutoLISP.
(defun eval_func (/ rep tmp)
   (if (not _last_eval_)
      (setq _last_eval_ "")
   )
   (setq rep (wc_fetch_string _last_eval_ "Enter function to evaluate:" ""))
   (if rep
      (progn
         (setq _last_eval_ rep)
         (setq tmp (eval (read rep)))
         (if tmp
            (progn
               (setq tmp (etos tmp)) ; converts whatever is returned to a string
               (if tmp
                  (wc_fetch_string tmp "Lisp evaluation returned: " "Press <ESC> to continue" )
               )
            )
         )
      )
   )
)
(wcconfig "eval_func" 1.0 "Access AutoLISP directly")

;;;This routine is used for returning the scancode value of a key pressed. The
;;;routine  will  ask  you for a string/comment of the key and then ask you to
;;;hit  that  key.  It  will then place the scancode value for that key at the
;;;current  cursor  position followed by ');' and the comment previously typed
;;;in.  This  function  should  be  played  with  to  obtain a method which is
;;;comfortable for you.
(defun getcode();/ lst str key line col SS)
   (WC_refresh 0)
   (if (not _last_code_name_)
      (setq _last_code_name_ "")
   )
   (setq lst(WC_statistics))
   (setq line(WC_row -1.0))
   (setq col (WC_col -1.0))
   (setq key(WC_message "Hit key --> " 0))
   (setq sS (wc_gname key))
   (if ss
      (setq str(strcat " (WC_gkey \""(wc_gname key) "\")" ))
      (setq str (RTOS key 2 0))
   )
   (WC_silent 0)
   (WC_trigger "INSERT_LINE_A")
   (WC_replace_line str);Replaces the line
   (WC_race_home 0)
   (WC_trigger "BEGIN_COL_MARK")       ;Set a line mark
   (WC_race_end 0)
   (WC_trigger "END_MARK")             ;Set the end mark
   (WC_trigger "BCUT")     ;Save the marked text
   (WC_row line)
   (WC_col col)
   (WC_move_down 1.0)
   (WC_trigger "DUMP_SCRAP")
   (WC_row line )
   (WC_col col)
   (WC_trigger "DELETE_LINE")
   (WC_refresh 0)
   (prin1)
)
(wcconfig "getcode" 1.0 "Insert the ascii/scan code for a key")

;;;This function will do the following:
;;;   1.)Check all brackets.
;;;   2.)If brackets are ok, then write the file to disk.
;;;   3.)If 1 and 2 are ok then load the file.
(defun force_load(/ lst ls sd fname oldcomm oldjump check);This routine is used to
   (setq lst(WC_STATISTICS))                    ;assist you in your lisp
   (if lst                                      ;developemnt. While writing
      (progn                                    ;your code you may hit CNT_L
         (setq sd(nth 14 lst))                  ;and your function will be
         (setq fname (gcname))                  ;bracket/string checked,
         ;saved to file and loaded
         ;back into AutoCAD.
         ;Use the function 'add_name'
         ;F8 to place your routine on
         (if (not _IGNORE_)
            (setq check(WC_trigger "DO_ALL_BRACKET"))
         )
         (if( = check 1)
            (progn
               (WC_message (strcat "Please wait loading " fname) 1)
               (WC_HARD_WRITE)
               (load fname "WCerr")
               (WC_refresh 1)
               (WC_print (strcat fname " is reloaded"))
               ;(wc_trigger "QUIT") Optional
            )
            (WC_message "Unmatch parenthesis!" 0)
         )
      )
   )
)
(wcconfig "force_load" 1.0 "Inspect write and load the current AutoLISP file")

;;; add_name <currently assigned to F8> now selects a default function
;;; name as the first name after the first defun found from the current
;;; cursor position. Simply place the cursor on the line , or above,
;;; of the function and hit F8. Add_name should find the appropriate
;;; name to use for the default or nothing if it could not find a
;;; a 'defun'. REGISTER.
(defun add_name(/ flag str a)
   (WC_race_home 0)
   (setq flag 't)
   ;  (WC_set_words 41 125); <<-- Excludes any parenthesis
   (setq oldcase(WC_getvar "TOCASE"))
   (WC_setvar "tocase" 0)
   (if( = (wc_find "defun") 1)
      (progn
         (setq str(WC_next_word))
         (WC_setvar "tocase" oldcase)
         (setq str(WC_FETCH_STRING str " Enter Lisp name " ""))
         (if str
            (progn
               (setq a(WC_message "Enter Your Define key" 0))
               ;(setq a(atoi(rtos a 2 2)));Forces to int if it's a real
               (if (and a(/= a (wc_gkey "Escape")))
                  (progn
                     (WCconfig str a)
                     (if (not(eval(read str))) ;Test to see if it is defined
                        (WC_message "You must load before activating!" 0)
                     )
                     (WC_message "Function is Registered" 0);
                  )
                  (progn
                     (if (= a (wc_gkey "Escape"))
                        (WC_print "User canceled")
                     )
                     (if (> (strlen (WC_castchar a)) 0)
                        (WC_message "Should not use alfa numeric keys for defines" 0)
                     )
                  )
               )
            )
         )
      )
   )
)
(wcconfig "add_name" 1.0 "Register the next function to WCEdit")

;;;I like to use this function to "kick" strings to the right since
;;;I prefer working with insert mode off. The routine will place
;;;the current tabwidth's amount of spaces at the cursor position.
(defun intab(/ mode str tabw ch)
   (setq mode(WC_getvar "insert_mode") str "" tabw (WC_getvar "TABWIDTH"))
   (WC_silent 1)
   (wc_race_home 0)
;  (wc_trigger "NEXT_WORD")

   (WC_pad_left tabw)
   (WC_move_down 1.0)
   (WC_race_home 0.0)
   (WC_silent 0)
   (WC_refresh 0);Resets silent to 0
)
(wcconfig "intab" 1.0 "Insert TABWIDTH spaces at left of line")

(defun zap_curr(old / lst num i nme )
   (setq lst(wc_statistics) num(nth 13 lst) i (nth 18 lst))
   (if(< num 2)
      (progn
         (wc_silent 0)
         (wc_message "Attempt to delete buffer incorrect buffer" 0)
         (quit)
      )
   )
   (wc_new_file old)
   (if ( > num 1)
      (progn
         (wc_remove_buffer i)
      )
   )
)

(defun ins_crr()
   (wc_break_line)
   (wc_add_string "\n")
   (wc_wrap_up)
)

(defun print_file( ) ; / row col fstat len is OLDF crow flag )
   (setq row (wc_row -1.0)col (wc_col -1.0) fstat(wc_statistics)
      is(nth 3 fstat)  oldf(gcname) len (nth 2 fstat)
      crow 0 flag 't down 60 page 1 page_st 50
   )
   ;(textscr)
   ;(wc_cls)
   (wc_window 20  1  60 6 1 1)
   (wc_display 21 2 "  The  print options available  do  not" )
   (wc_display 21 3 "  affect the current  file.   All  pre-")
   (wc_display 21 4 "  processing is done in a spare buffer." )
   (wc_display 21 5 "  Only text mode printing is supported."  )
   (setq pconf(list 66 "NO" 50 "PRN" 5 3 3) flag 't a 0)
   (while flag
      (setq a
         (wc_tmenu "══════ Print options Editor ══════" a
            (list
               (strcat " Lines per page:       " (itoa (nth 0 pconf))) ;0
               (strcat " Include page numbers: " (nth 1 pconf))        ;1
               (strcat " Column for page #:    "(itoa (nth 2 pconf)))  ;2
               (strcat " Sent file to:         "(nth 3 pconf))         ;3
               (strcat " Left margin:          "(itoa (nth 4 pconf)))  ;4
               (strcat " Top margin:           "(itoa (nth 5 pconf)))  ;5
               (strcat " Bottom margin:        "(itoa (nth 6 pconf)))  ;6
               "Print the file "
               "Exit to exitor "
            )
         )
      )
      (cond
         ((= a 0)
            (setq tempi(wc_fetch_int " Enter lines per page: " 3 (nth 0 pconf)))
            (if (> tempi 0)
               (setq pconf(list tempi (nth 1 pconf) (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
            )
         )
         ((= a 1)
            (if(= (nth 1 pconf) "NO")
               (setq pconf(list (nth 0 pconf) "YES" (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
               (setq pconf(list (nth 0 pconf) "NO" (nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
            )
         )
         ((= a 2)
            (setq tempi(wc_fetch_int " Enter Column for page #: " 3 (nth 2 pconf)))
            (if (> tempi 0)
               (setq pconf(list (nth 0 pconf)(nth 1 pconf) tempi(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
            )
         )
         ((= a 3)
            (setq opt
               (list
                  "PRN"
                  "LPT1"
                  "LPT2"
               )
            )
            (cond
               ((= (nth 3 pconf)(nth 0 opt))
                  (setq opt_def 0)
               )
               ((= (nth 3 pconf)(nth 1 opt))
                  (setq opt_def 1)
               )
               ((= (nth 3 pconf)(nth 2 opt))
                  (setq opt_def 2)
               )
            )
            (setq k
               (wc_tmenu " Printer output " opt_def
                  (setq opt
                     (list
                        "PRN"
                        "LPT1"
                        "LPT2"
                     )
                  )
               )
            )
            (if ( and (< k 3)(>= k  0))
               (progn
                  (setq pconf(list (nth 0 pconf)(nth 1 pconf) tempi(nth k opt)(nth 4 pconf)(nth 5 pconf)(nth 6 pconf)))
               )
            )
         )
         ((= a 4);Left margin
            (setq tempi(wc_fetch_int " Enter Left Margin: " 3 (nth 4 pconf)))
            (if (>= tempi 0)
               (setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)tempi(nth 5 pconf)(nth 6 pconf)))
            )
         )
         ((= a 5);Top margin
            (setq tempi(wc_fetch_int " Enter Top Margin: " 3 (nth 5 pconf)))
            (if (>= tempi 0)
               (setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)(nth 4 pconf)tempi(nth 6 pconf)))
            )
         )
         ((= a 6);Bot margin
            (setq tempi(wc_fetch_int " Enter Bottom Margin: " 3 (nth 6 pconf)))
            (if (>= tempi 0)
               (setq pconf(list (nth 0 pconf)(nth 1 pconf)(nth 2 pconf)(nth 3 pconf)(nth 4 pconf)(nth 5 pconf)tempi))
            )
         )
         ((= a 7)
            (wc_message "Printing. Please wait..." 1)
            (setq flag 't)
            (if(= (nth 3 fstat) 0)
               (progn
                  (wc_race_home 2)
                  (wc_trigger "BEGIN_LINE_MARK")
                  (wc_race_end 2)
                  (wc_trigger "END_MARK")
               )
            )
            (setq down(nth 0 pconf))
            (setq page_st(nth 2 pconf))
            (setq page(nth 0 pconf))
            (wc_trigger "DUMP_TO_SCRAP")
            (wc_new_file "$TRASH$")
            (wc_flush_buffer)
           ;(wc_setvar "LAST_SCRAP" 1)
            (wc_trigger "DUMP_SCRAP")
            (if(> (nth 4 pconf) 0)
               (repeat (atoi(rtos (nth 2 (wc_statistics)) 2 2));(nth 2 (wc_statistics))
                  (wc_pad_left (nth 4 pconf))
                  (wc_move_down 1.0)
               )
            )
            (wc_race_home 2)
            (setq len(nth 2 (wc_statistics))crow(wc_row -1.0))
            (wc_col 0.0)
            (while flag
               (repeat(nth 5 pconf);Top margin
                  (ins_crr)
                  (wc_move_right 1.0)
               )
               (wc_stuff_char (wc_castchar 13))
      (wc_move_down (atof(rtos(- page (+ (nth 6 pconf)(nth 5 pconf)))2 2)))
               (setq crow(wc_row -1.0))
               (if (<= crow len)
                  (progn
                     (wc_col 0.0)
                     (wc_stuff_char (wc_castchar 12))
                     (wc_move_right 1.0)
                  )
                  (setq flag nil)
               )
            )
            (wc_race_home 2)
            (wc_trigger "BEGIN_LINE_MARK")
            (wc_race_end 2)
            (wc_trigger "END_MARK")
            (wc_trigger "DUMP_TO_SCRAP")
            (wc_write_scrap (nth 3 pconf))
            (zap_curr oldf)
            (wc_row row)
            (wc_col col)
            (WC_refresh 1)
            (setq flag nil)
         )
         (t
            (setq flag nil)
         )
      )
   )
)

(wcconfig "print_FILE" 1.0 "Print the file or marked block")

;;;This program will create an AutoLISP program for the current
;;;macro defined. The output is placed into macs.lsp.
(defun create_lisp( / row col oldf flag len lst str is i crow key
   name desc ans ll)
   (setq row (wc_row -1.0)col (wc_col -1.0) lst(wc_statistics)
      is(nth 3 lst)  oldf(gcname) len (nth 2 lst)
      crow 0 flag 't
   )
   (setq lst(wc_get_macro))
   (setq key(wc_message "Hit the key to assign" 0))
   (if (/= key 283.0)
      (progn
         (setq name(wc_fetch_string "" " Enter a macro name " ""))
         (setq desc(wc_fetch_string "" " Enter a description " ""))
         (if (and name desc)
            (progn
               (wcconfig name key desc)
               (wc_new_file "$TRASH$")
               (wc_flush_buffer)
               (wc_replace_line (strcat ";;;Macro: " desc))
               (wc_move_down 1.0)
               (wc_replace_line (strcat "(defun " name "(/ lst index)"))
               (wc_move_down 1.0)
               (wc_replace_line "(setq index 0 lst (list" )
               (wc_move_down 1.0)
               (setq index 0)
               (repeat (length lst)
                  (setq ll(wc_gfunc (nth index lst))str(wc_gname (nth index lst)))
                  (if(not str)
                     (setq str "Unknown key")
                  )
                  (if ll
                     (wc_replace_line (strcat "(wc_first_key \"" (nth 1 ll) "\")" ))
                     (wc_replace_line (strcat  (rtos (nth index lst) 2 1) " ;;;" str ))
                  )
                  (wc_pad_left (* 3 (wc_getvar "TABWIDTH")))
                  (wc_move_down 1.0)
                  (setq index(+ 1 index))
               )
               (wc_replace_line  "))")
               (wc_move_down 1.0)
               (wc_replace_line "(repeat (length lst)")
               (wc_move_down 1.0)
               (wc_replace_line "(wc_stuffkey (nth index lst))")
               (wc_move_down 1.0)
               (wc_replace_line "(setq index(+ 1 index))")
               (wc_move_down 1.0)
               (wc_replace_line ")")
               (wc_move_down 1.0)
               (wc_replace_line ");;;End macro")
               (wc_move_down 1.0)
               (wc_replace_line (strcat "(wcconfig \"" name "\" 1.0 \"" desc"\");;;Window register."))
               (wc_trigger "PPRINT_ALL")
               (wc_race_home 2)
               (wc_trigger "BEGIN_LINE_MARK")
               (wc_race_end 2)
               (wc_trigger "END_MARK")
               (wc_trigger "DUMP_TO_SCRAP")
               (wc_flush_buffer)
               (zap_curr oldf)
               (if(setq str(findfile "MACS.LSP"))
                  (WC_new_file str)
                  (WC_new_file "MACS.LSP")
               )
               (wc_race_end 2)
               (wc_move_down 2.0)
               (wc_trigger "DUMP_SCRAP")
               (wc_trigger "UHARD")
               (load "MACS")
               (zap_curr oldf)
               (wc_row row)
               (wc_col col)
               (wc_message "Key is assigned and MACS.LSP is appended" 0)
            )
         )
      )
   )
)
(wcconfig "create_lisp" 1.0 "Create Lisp file from current macro.")

(defun rem_trail(str / i ch outstr)
   (wc_trimends str)
)

(defun c:shll()
   (if(not __last_shll)
      (setq __last_shll "")
   )
   (setq par(wc_fetch_string __last_shll " Enter DOS command " ""))
   (if par
      (progn
         (if par
            (setq par(rem_trail par))
         )
         (wc_cls)
         (setvar "cmdecho" 0)
         (setq emode (nth 19 (wc_statistics)))
         (setq mouse (wc_getvar "UMOUSE"))
         (wc_mouse 0)
         (if(or(= emode 50)(= emode 43))
            (wc_setmode_now 0)
         )
         (wc_cls)
         (wc_setcurs 1 1)
         (if par
            (progn
               (setq __last_shll par)
               (command "sh" par)
            )
            (progn
               (command "sh" "")
            )
         )
         (wc_message "Press any key to return" 0)
         (if(or(= emode 50)(= emode 43))
            (progn
               (wc_setmode_now 1)
               (wc_setvar "UMOUSE" mouse)
               (wc_mouse mouse)
            )
         )
         (wc_refresh 1)
      )
   )
   (prin1)
)

(wcconfig "C:shll" 1.0 "Shell to DOS.")

(defun dispkey(i);0 trigger,1 External
   (setq lst (wc_gfunc i))
   (if lst
      (progn
         (if (= (nth 0 lst) 1)
            (setq str "<E> ")
            (setq str "")
         )
         (setq str (strcat str (nth 1 lst) " - " (nth 2 lst)))
         (wc_message str 0)
      )
      (wc_message "Unknown" 0)
   )
   (prin1)
)

(prin1)